home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / dev / basic / AmosBlitz_src.lha / Sourcecodes / PictureBench.AMOS / PictureBench.amosSourceCode
Encoding:
AMOS Source Code  |  1995-07-12  |  11.8 KB  |  355 lines
  1. Dim FILE$(100)
  2. Global AN,FILE$(),FI$,ED$,N,PASS
  3. PATH$=""
  4. FILT$=""
  5. PASS=0
  6.  
  7. ANF:
  8. Request Wb 
  9. X=320 : Y=200 : ANZ=15
  10. Screen Open 0,640,256,16,Hires
  11. Curs Off : Flash Off : Colour 1,$0 : Cls 0 : Colour Back $AAA
  12. Palette $AAA,,
  13. Colour 17,$EDD : Colour 18,$E00 : Colour 19,0
  14.  
  15. Bar 0,0 To 639,10 : Ink 1 : Draw 0,10 To 639,10 : Draw 639,10 To 639,0
  16. Ink 1,2 : Text 3,7,"Picture Bench 1.0                            Programmiert von Frank Otto (1995)"
  17. Limit Mouse 129,43 To 447,297
  18.    QUAD2[0,12,128,82]
  19.    QUAD2[131,12,255,82]
  20.    QUAD2[258,12,383,82]
  21.    QUAD2[386,12,511,82]
  22.    QUAD2[514,12,639,82]
  23.    
  24.    QUAD2[0,84,128,154]
  25.    QUAD2[131,84,255,154]
  26.    QUAD2[258,84,383,154]
  27.    QUAD2[386,84,511,154]
  28.    QUAD2[514,84,639,154]
  29.    
  30.    QUAD2[0,156,128,226]
  31.    QUAD2[131,156,255,226]
  32.    QUAD2[258,156,383,226]
  33.    QUAD2[386,156,511,226]
  34.    QUAD2[514,156,639,226]
  35.    
  36.    QUAD2[0,230,639,249]
  37.  
  38.  
  39. Locate 1,29 : Paper 0 : Pen 1 : Print "Chip-Ram:";Chip Free
  40. Locate 1, : Print "Fast-Ram:";Fast Free
  41. Locate 61,29 : _DATE$ : Print "Datum: ";Param$
  42. Locate 61,30 : _TIME$ : Print "Zeit:  ";Param$
  43. Locate 34,29 : Print "0 Bilder geladen"
  44. Paper 1 : Pen 2
  45. Menu$(1)=" Projekt "
  46. Menu$(1,1)="Neu      [F1]"
  47. Menu$(1,2)="Ende [Ctrl+C]"
  48. Menu$(2)=" Bilder "
  49. Menu$(2,1)="Laden     [F2]"
  50. Menu$(2,2)="Gr��e     [F3]"
  51. Menu$(2,3)="Speichern [F4]"
  52. Menu$(2,4)="Drucken   [F5]"
  53. Menu$(3)=" Anzeigen "
  54. Menu Key(1,1) To 80
  55. Menu Key(2,1) To 81
  56. Menu Key(2,2) To 82
  57. Menu Key(2,3) To 83
  58. Menu Key(2,4) To 84
  59. Menu On 
  60.  
  61.  
  62. Menu Static(1)
  63. Menu Static(2,1)
  64. Menu Static(1,1)
  65.  
  66. Menu Base 0,1
  67. LOP:
  68. Do 
  69.    Paper 0 : Pen 1
  70.    Locate 1,29 : Print "Chip-Ram:";Chip Free
  71.    Locate 1, : Print "Fast-Ram:";Fast Free
  72.    Locate 61,29 : _DATE$ : Print "Datum: ";Param$
  73.    Locate 61,30 : _TIME$ : Print "Zeit:  ";Param$
  74.    If Choice
  75.       If Choice(1)=1 and Choice(2)=1 : Menu Off : Goto ANF : End If 
  76.       If Choice(1)=1 and Choice(2)=2 : End : End If 
  77.       If Choice(1)=2 and Choice(2)=1 : Gosub LADEN : End If 
  78.       If Choice(1)=2 and Choice(2)=2 : Gosub GROESSE : End If 
  79.       If Choice(1)=2 and Choice(2)=3 : Gosub SPEICHERN : End If 
  80.       If Choice(1)=2 and Choice(2)=4 : Gosub DRUCKEN : End If 
  81.       If Choice(1)=3 and Choice(2)=1 : Menu Off : Screen Hide 0 : Load Iff F1$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  82.       If Choice(1)=3 and Choice(2)=2 : Menu Off : Screen Hide 0 : Load Iff F2$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  83.       If Choice(1)=3 and Choice(2)=3 : Menu Off : Screen Hide 0 : Load Iff F3$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  84.       If Choice(1)=3 and Choice(2)=4 : Menu Off : Screen Hide 0 : Load Iff F4$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  85.       If Choice(1)=3 and Choice(2)=5 : Menu Off : Screen Hide 0 : Load Iff F5$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  86.       If Choice(1)=3 and Choice(2)=6 : Menu Off : Screen Hide 0 : Load Iff F6$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  87.       If Choice(1)=3 and Choice(2)=7 : Menu Off : Screen Hide 0 : Load Iff F7$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  88.       If Choice(1)=3 and Choice(2)=8 : Menu Off : Screen Hide 0 : Load Iff F8$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  89.       If Choice(1)=3 and Choice(2)=9 : Menu Off : Screen Hide 0 : Load Iff F9$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  90.       If Choice(1)=3 and Choice(2)=10 : Menu Off : Screen Hide 0 : Load Iff F10$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  91.       If Choice(1)=3 and Choice(2)=11 : Menu Off : Screen Hide 0 : Load Iff F11$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  92.       If Choice(1)=3 and Choice(2)=12 : Menu Off : Screen Hide 0 : Load Iff F12$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  93.       If Choice(1)=3 and Choice(2)=13 : Menu Off : Screen Hide 0 : Load Iff F13$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  94.       If Choice(1)=3 and Choice(2)=14 : Menu Off : Screen Hide 0 : Load Iff F14$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  95.       If Choice(1)=3 and Choice(2)=15 : Menu Off : Screen Hide 0 : Load Iff F15$,1 : While Mouse Click=0 : Wend : Menu On : Screen Close 1 : Screen Show 0 : End If 
  96.    End If 
  97. Loop 
  98.  
  99. LADEN:
  100. On Error Goto ERR
  101. For I=1 To 15
  102.    LAD$="IFF-Bild"+Str$(I)+" laden"
  103.    If I=1
  104.       F1$=Fsel$("","",LAD$)
  105.       If Exist(F1$)=0 : Return : End If 
  106.       Load Iff F1$,1
  107.    End If 
  108.    If I=2
  109.       F2$=Fsel$("","",LAD$)
  110.       If Exist(F2$)=0 : Return : End If 
  111.       Load Iff F2$,1
  112.    End If 
  113.    If I=3
  114.       F3$=Fsel$("","",LAD$)
  115.       If Exist(F3$)=0 : Return : End If 
  116.       Load Iff F3$,1
  117.    End If 
  118.    If I=4
  119.       F4$=Fsel$("","",LAD$)
  120.       If Exist(F4$)=0 : Return : End If 
  121.       Load Iff F4$,1
  122.    End If 
  123.    If I=5
  124.       F5$=Fsel$("","",LAD$)
  125.       If Exist(F5$)=0 : Return : End If 
  126.       Load Iff F5$,1
  127.    End If 
  128.    If I=6
  129.       F6$=Fsel$("","",LAD$)
  130.       If Exist(F6$)=0 : Return : End If 
  131.       Load Iff F6$,1
  132.    End If 
  133.    If I=7
  134.       F7$=Fsel$("","",LAD$)
  135.       If Exist(F7$)=0 : Return : End If 
  136.       Load Iff F7$,1
  137.    End If 
  138.    If I=8
  139.       F8$=Fsel$("","",LAD$)
  140.       If Exist(F8$)=0 : Return : End If 
  141.       Load Iff F8$,1
  142.    End If 
  143.    If I=9
  144.       F9$=Fsel$("","",LAD$)
  145.       If Exist(F9$)=0 : Return : End If 
  146.       Load Iff F9$,1
  147.    End If 
  148.    If I=10
  149.       F10$=Fsel$("","",LAD$)
  150.       If Exist(F10$)=0 : Return : End If 
  151.       Load Iff F10$,1
  152.    End If 
  153.    If I=11
  154.       F11$=Fsel$("","",LAD$)
  155.       If Exist(F11$)=0 : Return : End If 
  156.       Load Iff F11$,1
  157.    End If 
  158.    If I=12
  159.       F12$=Fsel$("","",LAD$)
  160.       If Exist(F12$)=0 : Return : End If 
  161.       Load Iff F12$,1
  162.    End If 
  163.    If I=13
  164.       F13$=Fsel$("","",LAD$)
  165.       If Exist(F13$)=0 : Return : End If 
  166.       Load Iff F13$,1
  167.    End If 
  168.    If I=14
  169.       F14$=Fsel$("","",LAD$)
  170.       If Exist(F14$)=0 : Return : End If 
  171.       Load Iff F14$,1
  172.    End If 
  173.    If I=15
  174.       F15$=Fsel$("","",LAD$)
  175.       If Exist(F15$)=0 : Return : End If 
  176.       Load Iff F15$,1
  177.    End If 
  178.    Screen 0 : Get Palette 1
  179.    If I=1 Then Zoom 1,0,0,X,Y To 0,1,23,128,82 : Locate 34,29 : Print "1 Bild geladen  "
  180.    If I=2 Then Zoom 1,0,0,X,Y To 0,132,23,255,82 : Locate 34,29 : Print "2 Bilder geladen"
  181.    If I=3 Then Zoom 1,0,0,X,Y To 0,259,23,383,82 : Locate 34,29 : Print "3 Bilder geladen"
  182.    If I=4 Then Zoom 1,0,0,X,Y To 0,387,23,511,82 : Locate 34,29 : Print "4 Bilder geladen"
  183.    If I=5 Then Zoom 1,0,0,X,Y To 0,516,23,639,82 : Locate 34,29 : Print "5 Bilder geladen"
  184.    If I=6 Then Zoom 1,0,0,X,Y To 0,1,95,128,154 : Locate 34,29 : Print "6 Bilder geladen"
  185.    If I=7 Then Zoom 1,0,0,X,Y To 0,132,95,255,154 : Locate 34,29 : Print "7 Bilder geladen"
  186.    If I=8 Then Zoom 1,0,0,X,Y To 0,259,95,383,154 : Locate 34,29 : Print "8 Bilder geladen"
  187.    If I=9 Then Zoom 1,0,0,X,Y To 0,387,95,511,154 : Locate 34,29 : Print "9 Bilder geladen"
  188.    If I=10 Then Zoom 1,0,0,X,Y To 0,516,95,639,154 : Locate 34,29 : Print "10 Bilder geladen"
  189.    If I=11 Then Zoom 1,0,0,X,Y To 0,1,167,128,226 : Locate 34,29 : Print "11 Bilder geladen"
  190.    If I=12 Then Zoom 1,0,0,X,Y To 0,132,167,255,226 : Locate 34,29 : Print "12 Bilder geladen"
  191.    If I=13 Then Zoom 1,0,0,X,Y To 0,259,167,383,226 : Locate 34,29 : Print "13 Bilder geladen"
  192.    If I=14 Then Zoom 1,0,0,X,Y To 0,387,167,511,226 : Locate 34,29 : Print "14 Bilder geladen"
  193.    If I=15 Then Zoom 1,0,0,X,Y To 0,516,167,639,226 : Locate 34,29 : Print "15 Bilder geladen"
  194.    Screen Close 1
  195.    Colour Back $0
  196.    M=0
  197.    Do 
  198.       Inc M
  199.       If I=1 Then B$=Right$(F1$,M)
  200.       If I=2 Then B$=Right$(F2$,M)
  201.       If I=3 Then B$=Right$(F3$,M)
  202.       If I=4 Then B$=Right$(F4$,M)
  203.       If I=5 Then B$=Right$(F5$,M)
  204.       If I=6 Then B$=Right$(F6$,M)
  205.       If I=7 Then B$=Right$(F7$,M)
  206.       If I=8 Then B$=Right$(F8$,M)
  207.       If I=9 Then B$=Right$(F9$,M)
  208.       If I=10 Then B$=Right$(F10$,M)
  209.       If I=11 Then B$=Right$(F11$,M)
  210.       If I=12 Then B$=Right$(F12$,M)
  211.       If I=13 Then B$=Right$(F13$,M)
  212.       If I=14 Then B$=Right$(F14$,M)
  213.       If I=15 Then B$=Right$(F15$,M)
  214.       If Left$(B$,1)="/" Then Exit 
  215.    Loop 
  216.    If I=1 Then Ink 1,0 : B$=Left$(B$,16) : Text 4,20,B$-"/"
  217.    If I=2 Then Ink 1,0 : B$=Left$(B$,16) : Text 135,20,B$-"/"
  218.    If I=3 Then Ink 1,0 : B$=Left$(B$,16) : Text 262,20,B$-"/"
  219.    If I=4 Then Ink 1,0 : B$=Left$(B$,16) : Text 390,20,B$-"/"
  220.    If I=5 Then Ink 1,0 : B$=Left$(B$,16) : Text 518,20,B$-"/"
  221.    If I=6 Then Ink 1,0 : B$=Left$(B$,16) : Text 4,92,B$-"/"
  222.    If I=7 Then Ink 1,0 : B$=Left$(B$,16) : Text 135,92,B$-"/"
  223.    If I=8 Then Ink 1,0 : B$=Left$(B$,16) : Text 262,92,B$-"/"
  224.    If I=9 Then Ink 1,0 : B$=Left$(B$,16) : Text 390,92,B$-"/"
  225.    If I=10 Then Ink 1,0 : B$=Left$(B$,16) : Text 518,92,B$-"/"
  226.    If I=11 Then Ink 1,0 : B$=Left$(B$,16) : Text 4,164,B$-"/"
  227.    If I=12 Then Ink 1,0 : B$=Left$(B$,16) : Text 135,164,B$-"/"
  228.    If I=13 Then Ink 1,0 : B$=Left$(B$,16) : Text 262,164,B$-"/"
  229.    If I=14 Then Ink 1,0 : B$=Left$(B$,16) : Text 390,164,B$-"/"
  230.    If I=15 Then Ink 1,0 : B$=Left$(B$,16) : Text 518,164,B$-"/"
  231.    Paper 1 : Pen 2
  232.    If I<11
  233.       If I=10 : Menu$(3,I)=B$-"/"+" [ 0]" : End If 
  234.       If I=10=0 : Menu$(3,I)=B$-"/"+" ["+Str$(I)+"]" : End If 
  235.       Menu Key(3,I) To I
  236.       Menu On 
  237.    End If 
  238.    If I>10
  239.       Menu$(3,I)=B$-"/"+" [F"+Str$(I-5)+"]"
  240.       Menu Key(3,I) To I+74
  241.       Menu On 
  242.    End If 
  243.    Paper 0 : Pen 1
  244. Next 
  245. Menu Static(3,1)
  246. Return 
  247.  
  248.  
  249. GROESSE:
  250. Wind Save 
  251. Menu Off 
  252. Wind Open 1,10,14,30,4,5 : Curs On 
  253. Input "Gr��e X: ";X
  254. Input "Gr��e Y: ";Y
  255. Wind Close 
  256. Menu On 
  257. Return 
  258.  
  259. SPEICHERN:
  260. Screen Open 1,640,256,16,Hires : Flash Off : Curs Off : Get Palette 0
  261. Screen Copy 0,0,12,640,246 To 1,0,0
  262. Ink 0 : Bar 0,216 To 640,256
  263. F$=Fsel$("","","IFF-Bild speichern")
  264. If F$="" Then Screen Close 1 : Return 
  265. Save Iff F$,1
  266. Screen Close 1
  267. Return 
  268.  
  269. DRUCKEN:
  270. Locate 29,30 : Print "Drucker an und on-line? (J/N)"
  271. Do 
  272.    If Inkey$="j" Then Exit 
  273.    If Inkey$="n" Then Locate 29,30 : Cline 29 : Return 
  274. Loop 
  275. Screen Open 1,640,256,16,Hires : Flash Off : Curs Off : Get Palette 0
  276. Screen Copy 0,0,12,640,246 To 1,0,0
  277. Ink 0 : Bar 0,216 To 640,256
  278. Printer Open 
  279. Printer Dump 
  280. Screen Close 1
  281. Return 
  282.  
  283. Procedure QUAD[X,Y,X1,Y1]
  284.    Ink 2 : Draw X,Y To X1,Y
  285.    Ink 2 : Draw X,Y To X,Y1
  286.    Ink 3 : Draw X,Y1 To X1,Y1
  287.    Ink 3 : Draw X1,Y To X1,Y1
  288. End Proc
  289. Procedure QUAD2[X,Y,X1,Y1]
  290.    Ink 3 : Draw X,Y To X1,Y
  291.    Ink 3 : Draw X,Y To X,Y1
  292.    Ink 2 : Draw X,Y1 To X1,Y1
  293.    Ink 2 : Draw X1,Y To X1,Y1
  294. End Proc
  295. Procedure _DATE$
  296.    '
  297.    ' Call DOS DateStamp function
  298.    T$=Space$(12)
  299.    Dreg(1)=Varptr(T$)
  300.    RIEN=Doscall(-192)
  301.    NJ=Leek(Varptr(T$))
  302.    '
  303.    ' Find this year's first day 
  304.    A=1978 : JOUR=7
  305.    Do 
  306.       BIS=0 : If(A and 3)=0 : BIS=1 : End If 
  307.       Exit If NJ-365-BIS<0
  308.       Add JOUR,1+BIS : If JOUR>7 : Add JOUR,-7 : End If 
  309.       Add NJ,-365-BIS
  310.       Inc A
  311.    Loop 
  312.    '
  313.    ' Find month 
  314.    M=1
  315.    Do 
  316.       Read N
  317.       Exit If NJ-N<0
  318.       Add NJ,-N : Inc M
  319.    Loop 
  320.    Inc NJ
  321.    '
  322.    ' Fabrique la chaine 
  323.       J$=Mid$(Str$(NJ),2) : If Len(J$)<2 : J$="0"+J$ : End If 
  324.       M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
  325.       A$=Mid$(Str$(A),2)
  326.       DATE$=J$+"."+M$+"."+A$
  327.    '
  328.    ' Length of each month 
  329.    Data 31,28+BIS,31,30,31,30,31,31,30,31,30,31
  330.    '
  331. End Proc[DATE$]
  332. Procedure _TIME$
  333.    '
  334.    ' Call DOS function
  335.    T$=Space$(12)
  336.    Dreg(1)=Varptr(T$)
  337.    RIEN=Doscall(-192)
  338.    MN=Leek(Varptr(T$)+4)
  339.    SEC=Leek(Varptr(T$)+8)
  340.    '
  341.    ' Minutes calculation
  342.    H=MN/60 : H$=Mid$(Str$(H),2) : If Len(H$)<2 : H$="0"+H$ : End If 
  343.    M=MN mod 60 : M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
  344.    '
  345.    ' Seconds calculation  
  346.    S=SEC/50 : S$=Mid$(Str$(S),2) : If Len(S$)<2 : S$="0"+S$ : End If 
  347.    '
  348.    ' Final string 
  349.    TIME$=H$+":"+M$+":"+S$
  350.    '
  351. End Proc[TIME$]
  352.  
  353. ERR:
  354. Locate 38,30 : Print "Fehler!"
  355. Resume LOP